home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / write_gif.pro < prev    next >
Text File  |  1997-07-08  |  5KB  |  182 lines
  1. ; $Id: write_gif.pro,v 1.5 1997/01/15 03:11:50 ali Exp $
  2. ;
  3. ; Copyright (c) 1992-1997, Research Systems, Inc.  All rights reserved.
  4. ;    Unauthorized reproduction prohibited.
  5.  
  6. PRO WRITE_GIF, FILE, IMG, R, G, B, MULTIPLE=mult, CLOSE=close
  7. ;+
  8. ; NAME:
  9. ;    WRITE_GIF
  10. ;
  11. ; PURPOSE:
  12. ;    Write an IDL image and color table vectors to a
  13. ;    GIF (graphics interchange format) file.
  14. ;
  15. ; CATEGORY:
  16. ;
  17. ; CALLING SEQUENCE:
  18. ;
  19. ;    WRITE_GIF, File, Image  ;Write a given array.
  20. ;
  21. ;    WRITE_GIF, File, Image, R, G, B  ;Write array with given color tables.
  22. ;
  23. ;
  24. ; INPUTS:
  25. ;    Image:    The 2D array to be output.
  26. ;
  27. ; OPTIONAL INPUT PARAMETERS:
  28. ;      R, G, B:    The Red, Green, and Blue color vectors to be written
  29. ;        with Image.
  30. ; Keyword Inputs:
  31. ;    CLOSE = if set, closes any open file if the MULTIPLE images
  32. ;        per file mode was used.  If this keyword is present,
  33. ;        nothing is written, and all other parameters are ignored.
  34. ;    MULTIPLE = if set, write files containing multiple images per
  35. ;        file.  Each call to WRITE_GIF writes the next image,
  36. ;        with the file remaining open between calls.  The File
  37. ;        parameter is ignored, but must be supplied,
  38. ;        after the first call.  When writing
  39. ;        the 2nd and subsequent images, R, G, and B are ignored.
  40. ;        All images written to a file must be the same size.
  41. ;
  42. ;
  43. ; OUTPUTS:
  44. ;    If R, G, B values are not provided, the last color table
  45. ;    established using LOADCT is saved. The table is padded to
  46. ;    256 entries. If LOADCT has never been called, we call it with
  47. ;    the gray scale entry.
  48. ;
  49. ;
  50. ; COMMON BLOCKS:
  51. ;    COLORS
  52. ;
  53. ; SIDE EFFECTS:
  54. ;    If R, G, and B aren't supplied and LOADCT hasn't been called yet,
  55. ;    this routine uses LOADCT to load the B/W tables.
  56. ;
  57. ; COMMON BLOCKS:
  58. ;    WRITE_GIF_COMMON.
  59. ; RESTRICTIONS:
  60. ;    This routine only writes 8-bit deep GIF files of the standard
  61. ;    type: (non-interlaced, global colormap, 1 image, no local colormap)
  62. ;
  63. ;    The Graphics Interchange Format(c) is the Copyright property
  64. ;    of CompuServ Incorporated.  GIF(sm) is a Service Mark property of
  65. ;    CompuServ Incorporated. 
  66. ;
  67. ; MODIFICATION HISTORY:
  68. ;    Written 9 June 1992, JWG.
  69. ;    Added MULTIPLE and CLOSE, Aug, 1996.
  70. ;-
  71. ; Copyright (c) 1992-1996, Research Systems, Inc.  All rights reserved.
  72. ;    Unauthorized reproduction prohibited.
  73. ;
  74.  
  75. COMMON WRITE_GIF_COMMON, unit, width, height, position
  76. COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
  77.  
  78. ; Check the arguments
  79. ON_ERROR, 2            ;Return to caller if error
  80. n_params = N_PARAMS();
  81.  
  82. if n_elements(unit) le 0 then unit = -1
  83.  
  84. if KEYWORD_SET(close) then begin
  85.   if unit ge 0 then FREE_LUN, unit
  86.   unit = -1
  87.   return
  88.   endif
  89.  
  90. IF ((n_params NE 2) AND (n_params NE 5))THEN $
  91.   message, "usage: WRITE_GIF, file, image, [r, g, b]'
  92.  
  93. ; Is the image a 2-D array of bytes?
  94.  
  95. img_size    = SIZE(img)
  96. IF img_size[0] NE 2 OR img_size[3] NE 1 THEN    $
  97.     message, 'Image must be a byte matrix.'
  98.  
  99.  
  100.  
  101. if keyword_set(mult) and unit ge 0 then begin
  102.   if width ne img_size[1] or height ne img_size[2] then $
  103.     message,'Image size incompatible'
  104.   point_lun, unit, position-1    ;Back up before terminator mark
  105. endif else begin        ;First call
  106.   width = img_size[1]
  107.   height = img_size[2]
  108.  
  109. ; If any color vectors are supplied, do they have right attributes ?
  110.   IF (n_params EQ 2) THEN BEGIN
  111.     IF (n_elements(r_curr) EQ 0) THEN LOADCT, 0    ; Load B/W tables
  112.     r    = r_curr
  113.     g    = g_curr
  114.     b    = b_curr
  115.   ENDIF
  116.  
  117.   r_size = SIZE(r)
  118.   g_size = SIZE(g)
  119.   b_size = SIZE(b)
  120.   IF ((r_size[0] + g_size[0] + b_size[0]) NE 3) THEN $
  121.     message, "R, G, & B must all be 1D vectors."
  122.   IF ((r_size[1] NE g_size[1]) OR (r_size[1] NE b_size[1]) ) THEN $
  123.     message, "R, G, & B must all have the same length."
  124.  
  125.   ;    Pad color arrays
  126.  
  127.   clrmap = BYTARR(3,256)
  128.  
  129.   tbl_size        = r_size[1]-1
  130.   clrmap[0,0:tbl_size]    = r
  131.   clrmap[0,tbl_size:*]    = r[tbl_size]
  132.   clrmap[1,0:tbl_size]    = g
  133.   clrmap[1,tbl_size:*]    = g[tbl_size]
  134.   clrmap[2,0:tbl_size]    = b
  135.   clrmap[2,tbl_size:*]    = b[tbl_size]
  136.  
  137.   ; Write the result
  138.   ; MACTYPE find me
  139.   if (!version.os EQ 'MacOS') then begin
  140.   OPENW, unit, file, /STREAM, /GET_LUN, MACTYPE = "GIFf"
  141.   endif else begin 
  142.   OPENW, unit, file, /STREAM, /GET_LUN
  143.   endelse
  144.  
  145.   hdr    =  { giffile, $        ;Make the header
  146.   magic:'GIF87a',         $
  147.   width_lo:0b, width_hi:0b,    $
  148.   height_lo:0b, height_hi:0b,    $
  149.   global_info: BYTE('F7'X),    $    ; global map, 8 bits color
  150.   background:0b, reserved:0b }        ; 8 bits/pixel
  151.  
  152.   hdr.width_lo    = width AND 255
  153.   hdr.width_hi    = width / 256
  154.   hdr.height_lo    = height AND 255
  155.   hdr.height_hi    = height / 256
  156.  
  157.   WRITEU, unit, hdr                ;Write header
  158.   WRITEU, unit, clrmap                ;Write color map
  159.  
  160. endelse                ;Not Multiple
  161.  
  162. ihdr    = {     imagic: BYTE('2C'X),        $    ; BYTE(',')
  163.     left:0, top: 0,            $
  164.     width_lo:0b, width_hi:0b,    $
  165.     height_lo:0b, height_hi:0b,    $
  166.     image_info:7b }
  167. ihdr.width_lo    = width AND 255
  168. ihdr.width_hi    = width / 256
  169. ihdr.height_lo    = height AND 255
  170. ihdr.height_hi    = height / 256
  171. WRITEU, unit, ihdr
  172.  
  173. ENCODE_GIF, unit, img
  174.  
  175. if keyword_set(mult) then begin ;Multiple image mode?
  176.   POINT_LUN, -unit, position    ;Get the position
  177. endif else begin        ;Single image/file
  178.   FREE_LUN, unit        ; Close file and free unit
  179.   unit = -1
  180. endelse
  181. END
  182.